home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / programr / wtj007.zip / POLYMOR.ZIP / PCHART.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-27  |  17KB  |  621 lines
  1. {**************************************************}
  2. {                    Chart 1.1                     }
  3. {                    Written in                    }
  4. {             Turbo Pascal for Windows             }
  5. {             Copyright (c) 1991,1992              }
  6. {                  Zack Urlocker                   }
  7. {                    04/22/92                      }
  8. {**************************************************}
  9.  
  10. program PCharts;
  11.  
  12. { This is a simple implementation of a charting program written
  13.   in Turbo Pascal for Windows using the ObjectWindows application
  14.   framework.  The program is divided into several object types:
  15.  
  16.   TChartApplication      --creates and shows the main window
  17.   TChartDialog           --BWCC dialog allows editing of data items
  18.   TNumEdit               --numeric input field
  19.   TChartWindow           --responds to Windows messages, menu commands,
  20.                            keyboard and mouse events
  21.   TChart and descendants --chart objects that can draw, rescale etc
  22.                            these are in the Charts unit
  23.   TDict and TAssoc       --data management objects
  24.                            these are in the Dicts unit
  25.  
  26.   Note: This program uses Borland Custom Controls.  Make sure that
  27.         BWCC.DLL is in your path.
  28. }
  29.  
  30. {$R PChart.res}        { Link in resources }
  31.  
  32. {$IFDEF Final}        { Remove debug code for final version}
  33. {$D-,I-,L-,R-,S-}
  34. {$ELSE}
  35. {$D+,I+,L+,R+,S+}
  36. {$ENDIF}
  37.  
  38. uses Dicts, WObjects, WinTypes, WinProcs, Strings, StdDlgs, Charts,
  39.      BWCC;
  40.  
  41. const
  42.  cm_New    = 501;       { Menu items }
  43.  cm_Open   = 502;
  44.  cm_Save   = 503;
  45.  cm_SaveAs = 504;
  46.  cm_Exit   = 508;
  47.  cm_About  = 509;
  48.  cm_HBar   = 555;
  49.  cm_VBar   = 556;
  50.  cm_V3DBar = 557;
  51.  cm_Pie    = 558;
  52.  cm_Change = 552;
  53.  cm_SetName= 553;
  54.  cm_Help   = 600;
  55.  cm_CmdMode= 601;      { For Lotus style slash (/) key commands }
  56.  
  57.  id_Label  = 101;       { Dialog box fields}
  58.  id_Value  = 102;
  59.  id_Delete = 104;
  60.  fieldLen  = 16;
  61.  
  62. type
  63.  
  64.   { The application defines startup behavior for the window. }
  65.   TChartApplication = object(TApplication)
  66.     procedure InitInstance; virtual;
  67.     procedure InitMainWindow; virtual;
  68.   end;
  69.  
  70.   { Dialog transfer record }
  71.   ItemTransferBuffer = record
  72.     LabelStr, ValueStr : array[0..FieldLen-1] of char;
  73.   end;
  74.  
  75.   { Numeric input field }
  76.   PNumEdit = ^TNumEdit;
  77.   TNumEdit = object(TEdit)
  78.     procedure wmChar(var Msg:TMessage); virtual wm_Char;
  79.   end;
  80.  
  81.  
  82.   { The dialog is used for input of new data items. }
  83.   PChartDialog = ^TChartDialog;
  84.   TChartDialog = object(TDialog)
  85.     LabelEdit: PEdit;
  86.     ValueEdit : PNumEdit;
  87.     constructor Init(AParent: PWindowsObject; ATitle:PChar);
  88.     procedure Delete(var Msg:TMessage); virtual id_First + id_Delete;
  89.   end;
  90.  
  91.   { The window responds to messages and controls the game board. }
  92.   PChartWindow = ^TChartWindow;
  93.   TChartWindow = object(TWindow)
  94.     Name : PChar;     { Name for file I/O     }
  95.     Chart : PChart;   { Pointer to a chartl   }
  96.     Saved : Boolean;  { has chart been saved? }
  97.     ItemBuffer : ItemTransferBuffer; { for ChartDialog }
  98.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  99.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  100.     procedure redraw;
  101.     function CanClose: Boolean; virtual;
  102.     procedure IOError(ErrMessage : PChar);
  103.     procedure SetCaption(FName : PChar);
  104.     function Read(fName : PChar): Boolean;
  105.     function Write(fName : PChar): Boolean;
  106.  
  107.     { menu response methods }
  108.     procedure NewFile(var Msg: TMessage); virtual cm_First + cm_New;
  109.     procedure Open(var Msg: TMessage); virtual cm_First + cm_Open;
  110.     procedure Save(var Msg: TMessage); virtual cm_First + cm_Save;
  111.     procedure SaveAs(var Msg: TMessage); virtual cm_First + cm_SaveAs;
  112.     procedure Exit(var Msg: TMessage); virtual cm_First + cm_Exit;
  113.     procedure HBar(var Msg: TMessage); virtual cm_First + cm_HBar;
  114.     procedure VBar(var Msg: TMessage); virtual cm_First + cm_VBar;
  115.     procedure V3DBar(var Msg: TMessage); virtual cm_First + cm_V3DBar;
  116.     procedure Pie(var Msg: TMessage); virtual cm_First + cm_Pie;
  117.     procedure Change(var Msg: TMessage); virtual cm_First + cm_Change;
  118.     procedure SetName(var Msg: TMessage); virtual cm_First + cm_SetName;
  119.     procedure About(var Msg: TMessage); virtual cm_First + cm_About;
  120.     procedure Help(var Msg: TMessage); virtual cm_First + cm_Help;
  121.     procedure CmdMode(var Msg: TMessage); virtual cm_First + cm_CmdMode;
  122.  
  123.     { windows message response methods }
  124.     procedure Paint(DC: HDC; var PaintInfo: TPaintStruct); virtual;
  125.     procedure wmSetFocus(var Msg: TMessage); virtual wm_SetFocus;
  126.     procedure wmKillFocus(var Msg: TMessage); virtual wm_KillFocus;
  127.     procedure wmLButtonDown(var Msg: TMessage); virtual wm_LButtonDown;
  128.     procedure wmKeyDown(var Msg: TMessage); virtual wm_KeyDown;
  129.     procedure wmSize(var Msg: TMessage); virtual wm_Size;
  130.   end;
  131.  
  132.  
  133. {--------------------------------------------------}
  134. { TChartApplication's method implementations:      }
  135. {--------------------------------------------------}
  136.  
  137. { Load the accelerator table for hotkeys }
  138. procedure TChartApplication.InitInstance;
  139. begin
  140.   Tapplication.InitInstance;
  141.   HAccTable := LoadAccelerators(HInstance, 'ChartKeys');
  142. end;
  143.  
  144. { Start the main window }
  145. procedure TChartApplication.InitMainWindow;
  146. begin
  147.   MainWindow := New(PChartWindow,
  148.                 Init(nil, 'PChart : (untitled)'));
  149. end;
  150.  
  151. {--------------------------------------------------}
  152. { TNumEdit method implementations:                 }
  153. {--------------------------------------------------}
  154.  
  155. { if the key is non-numeric then beep; otherwise process it }
  156. procedure TNumEdit.wmChar(var Msg:TMessage);
  157. var key : word;
  158. begin
  159.   key := Msg.wParam;
  160.   if ((key < word('0')) or (key > word('9')))
  161.      and (key <> vk_Back) 
  162.   then
  163.     MessageBeep(0)
  164.   else
  165.     defWndProc(Msg);
  166. end;
  167.  
  168. {--------------------------------------------------}
  169. { TChartDialog method implementations:             }
  170. {--------------------------------------------------}
  171.  
  172. { The edit controls will contain the transfer data. }
  173. constructor TChartDialog.Init(AParent: PWindowsObject; ATitle:PChar);
  174. begin
  175.   TDialog.Init(AParent, ATitle);
  176.   new(LabelEdit, initResource(@Self, id_Label, fieldLen));
  177.   new(ValueEdit, initResource(@Self, id_Value, fieldLen));
  178. end;
  179.  
  180. { Respond to Delete Button by transfering data out.
  181.   This is automatically done if the user presses Ok. }
  182. procedure TChartDialog.Delete(var Msg:TMessage);
  183. begin
  184.   TransferData(tf_GetData);
  185.   EndDlg(id_Delete);
  186. end;
  187.  
  188. {--------------------------------------------------}
  189. { TChartWindow's method implementations:           }
  190. {--------------------------------------------------}
  191.  
  192. { Initialize all fields to starting values }
  193. constructor TChartWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  194. var Msg : TMessage;
  195. begin
  196.   TWindow.Init(AParent, ATitle);
  197.   Chart := new(PVbarChart, init);
  198.   Saved := True;
  199.   getMem(Name, 255);
  200.   StrPcopy(ItemBuffer.LabelStr, 'Item');
  201.   StrPCopy(ItemBuffer.ValueStr, '50');
  202.   redraw;
  203.   with attr do
  204.   begin
  205.     w:=400;          { Force window size }
  206.     h:=300;
  207.   end;
  208. end;
  209.  
  210. { Override default cursor, icon, menu }
  211. procedure TChartWindow.GetWindowClass(var WndClass: TWndClass);
  212. begin
  213.   TWindow.GetWindowClass(WndClass);
  214.   WndClass.Style := 0;
  215.   WndClass.hCursor := LoadCursor(hInstance, 'ChartCur');
  216.   WndClass.hIcon := LoadIcon(hInstance, 'ChartIco');
  217.   WndClass.lpszMenuName := 'ChartMenu';
  218. end;
  219.  
  220. { Update the chart by rescaling, redrawing }
  221. procedure TChartWindow.redraw;
  222. begin
  223.   Chart^.area.x := attr.w;
  224.   Chart^.area.y := attr.h;
  225.   Chart^.reScale;
  226.   invalidateRect(HWindow, nil, True);
  227. end;
  228.  
  229. { Make sure the user has saved his work before closing }
  230. function TChartWindow.CanClose: Boolean;
  231. var Reply : Integer;
  232.     Msg : TMessage;
  233. begin
  234.   if not Saved then
  235.   begin
  236.     Reply := MessageBox(HWindow, 'File has not been saved. Save file before closing?',
  237.              'Warning', mb_IconStop or mb_YesNoCancel);
  238.     if Reply = id_Yes then
  239.       Save(Msg);
  240.   end;
  241.   CanClose := Saved or (Reply <> id_Cancel);
  242. end;
  243.  
  244. { Dispose of old chart and create a new one }
  245. procedure TChartWindow.NewFile(var Msg: TMessage);
  246. begin
  247.   if chart <> nil then Dispose(Chart, Done);
  248.   Chart := new(PVbarChart, init);
  249.   Saved := True;
  250.   StrDispose(Name);
  251.   GetMem(Name, 255);
  252.   setName(Msg);
  253.   StrPcopy(ItemBuffer.LabelStr, 'Item');
  254.   StrPCopy(ItemBuffer.ValueStr, '50');
  255.   redraw;
  256. end;
  257.  
  258. { Open a chart file }
  259. procedure TChartWindow.Open(var Msg: TMessage);
  260. var FName : PChar;
  261. begin
  262.   GetMem(FName, 255);
  263.   strPCopy(FName, '*.cht');
  264.   if application^.execDialog(New(PFileDialog,
  265.    init(@Self, PChar(sd_FileOpen), FName))) = ID_Ok then
  266.    begin
  267.      dispose(Chart, done);
  268.      Chart := new(PChart, init);
  269.      StrCopy(Name, FName);
  270.      if Read(FName) then
  271.        redraw
  272.      else
  273.        newFile(Msg);
  274.    end;
  275.   Strdispose(FName);
  276. end;
  277.  
  278. { Save the chart with existing name.  Call SaveAs if necessary. }
  279. procedure TChartWindow.Save(var Msg: TMessage);
  280. begin
  281.   if strScan(Name, '.') = nil then
  282.     strCat(Name, '.cht');
  283.   if strLen(Name) > 4 then
  284.     write(Name)
  285.   else
  286.     SaveAs(Msg);
  287. end;
  288.  
  289. { Save the chart under a new name }
  290. procedure TChartWindow.SaveAs(var Msg: TMessage);
  291. var len : Integer;
  292.   OldName : PChar;  { in case user cancels command }
  293. begin
  294.   getMem(OldName, 255);
  295.   strCopy(OldName, Name);
  296.   { give a default name and extension }
  297.   if strLen(Name) = 0 then
  298.   begin
  299.     len := StrLen(Chart^.Name);
  300.     if len > 8 then len := 8;
  301.     StrLCopy(Name, Chart^.Name, len);
  302.   end;
  303.   if StrScan(Name, '.') = nil then
  304.     StrCat(Name, '.cht');
  305.   if StrLen(Name) < 5 then
  306.     StrPCopy(Name, 'Chart.cht');
  307.  
  308.   if application^.execDialog(New(PFileDialog,
  309.      init(@Self, PChar(sd_FileSave), Name))) = ID_Ok then
  310.        write(Name)
  311.   else
  312.        StrCopy(Name, OldName);
  313.   strDispose(OldName);
  314. end;
  315.  
  316. { Report an I/O Error }
  317. procedure TChartWindow.IOError(ErrMessage : PChar);
  318. var Msg : Array[0..255] of Char;
  319. begin
  320.   MessageBeep(0);
  321.   strCopy(Msg, ErrMessage);
  322.   MessageBox(0, StrCat(Msg, Name), 'File Error', mb_IconExclamation);
  323. end;
  324.  
  325. { Set the caption of the window to the filename }
  326. procedure TChartWindow.SetCaption(FName : PChar);
  327. var Caption : PChar;
  328. begin
  329.   getMem(Caption, 255);
  330.   strPCopy(Caption, 'PChart : ');
  331.   SetWindowText(Hwindow, strCat(Caption, FName));
  332.   strDispose(Caption);
  333. end;
  334.  
  335. { Read a chart from a file. }
  336. function TChartWindow.Read(FName : PChar) : Boolean;
  337. var S : TBufStream;
  338. begin
  339.   S.Init(FName, StOpenRead, 1024);
  340.   if S.Status <> stOk then
  341.     IOError('Can''t open file ')
  342.   else
  343.     begin
  344.       Chart := PChart(S.Get);
  345.       if S.Status <> stOk then
  346.     IOError('Can''t read file ')
  347.       else
  348.       begin
  349.         setCaption(Name);
  350.         Saved := True;
  351.       end;
  352.     end;
  353.   S.Done;
  354.   Read := (S.Status = stOk);
  355. end;
  356.  
  357. { Store a chart onto a file by storing onto a stream. }
  358. function TChartWindow.Write(FName : PChar) : Boolean;
  359. var S : TBufStream;
  360. begin
  361.   S.Init(FName, stCreate, 1024);
  362.   if S.Status <> stOk then
  363.     IOError('Can''t create file ')
  364.   else
  365.     begin
  366.       S.put(Chart);
  367.       if S.Status <> stOk then
  368.     IOError('Can''t write file ')
  369.       else
  370.       begin
  371.         setCaption(Name);
  372.         Saved := True;
  373.       end;
  374.     end;
  375.   S.Done;
  376.   Write := (S.status = StOk);
  377. end;
  378.  
  379. { Make it a Horizontal Bar chart }
  380. procedure TChartWindow.HBar(var Msg: TMessage);
  381. Var Chart2 : PChart;
  382. begin
  383.   Chart2 := new(PHBarChart, init);
  384.   Chart2^.Items := Chart^.items;
  385.   Chart2^.Name := Chart^.Name;
  386.   Chart := PHBarChart(Chart2);
  387.   redraw;
  388. end;
  389.  
  390. { Make it a Vertical Bar chart }
  391. procedure TChartWindow.VBar(var Msg: TMessage);
  392. Var Chart2 : PChart;
  393. begin
  394.   Chart2 := new(PVBarChart, init);
  395.   Chart2^.Items := Chart^.items;
  396.   Chart2^.Name := Chart^.Name;
  397.   Chart := PVBarChart(Chart2);
  398.   redraw;
  399. end;
  400.  
  401. { Make it a Vertical Bar chart }
  402. procedure TChartWindow.V3DBar(var Msg: TMessage);
  403. Var Chart2 : PChart;
  404. begin
  405.   Chart2 := new(PV3DBarChart, init);
  406.   Chart2^.Items := Chart^.items;
  407.   Chart2^.Name := Chart^.Name;
  408.   Chart := PV3DBarChart(Chart2);
  409.   redraw;
  410. end;
  411.  
  412. { Make it a Pie chart }
  413. procedure TChartWindow.Pie(var Msg: TMessage);
  414. Var Chart2 : PChart;
  415. begin
  416.   Chart2 := new(PPieChart, init);
  417.   Chart2^.Items := Chart^.items;
  418.   Chart2^.Name := Chart^.Name;
  419.   Chart := PPieChart(Chart2);
  420.   redraw;
  421. end;
  422.  
  423. { Change, add or delete an item }
  424. procedure TChartWindow.Change(var Msg: TMessage);
  425. var  Dlg: TChartDialog;
  426.      Reply, Value, errorPos : Integer;
  427. begin
  428.   Dlg.Init(@Self, 'ChartDlg');
  429.   Dlg.TransferBuffer := @ItemBuffer;
  430.   Reply := Dlg.Execute;
  431.   Dlg.Done;
  432.   if Reply = id_Ok then
  433.   begin
  434.     { If valid, add the item to the chart }
  435.     val(ItemBuffer.ValueStr, value, errorPos);
  436.     if errorPos = 0 then
  437.     begin
  438.       if Chart = nil then
  439.         Chart := new(PVBarChart, init);
  440.       Chart^.add(ItemBuffer.LabelStr, Value);
  441.     end
  442.     else { Bad data entered }
  443.       MessageBeep(0);
  444.   end
  445.   else if Reply = id_Delete then
  446.      if Chart = nil then
  447.        MessageBeep(0)
  448.      else
  449.        Chart^.Remove(ItemBuffer.LabelStr);
  450.   { Adjust the chart }
  451.   if Reply <> id_Cancel then
  452.   begin
  453.     redraw;
  454.     Saved := False;
  455.   end;
  456. end;
  457.  
  458. { Set or change the name of the chart }
  459. procedure TChartWindow.SetName(var Msg: TMessage);
  460. var TempName : PChar;
  461. begin
  462.   GetMem(TempName, 40);
  463.   if Chart^.Name <> nil then
  464.     strLCopy(TempName, Chart^.Name, 40);
  465.   if application^.ExecDialog(New(PInputDialog,
  466.       Init(@Self, 'Chart', 'Enter chart name:',
  467.       TempName, 40))) = id_Ok then
  468.   begin
  469.      if chart^.Name <> nil then
  470.        strDispose(Chart^.Name);
  471.      getMem(Chart^.Name, 40);
  472.      strCopy(Chart^.Name, TempName);
  473.      redraw;
  474.   end;
  475.   strDispose(TempName);
  476. end;
  477.  
  478. { Display About box }
  479. procedure TChartWindow.About(var Msg: TMessage);
  480. var  Dlg: TDialog;
  481. begin
  482.   Dlg.Init(@Self, 'AboutDlg');
  483.   Dlg.Execute;
  484.   Dlg.Done;
  485. end;
  486.  
  487. { Display Help dialog }
  488. procedure TChartWindow.Help(var Msg: TMessage);
  489. var  Dlg: TDialog;
  490. begin
  491.   Dlg.Init(@Self, 'HelpDlg');
  492.   Dlg.Execute;
  493.   Dlg.Done;
  494. end;
  495.  
  496. { Respond to Lotus style commands from slash (/) accelerator }
  497. procedure TChartWindow.CmdMode(var Msg: TMessage);
  498. begin
  499.   sendMessage(HWindow, WM_SYSCOMMAND, $F100, 0);
  500. end;
  501.  
  502. { Exit the program }
  503. procedure TChartWindow.Exit(var Msg: TMessage);
  504. begin
  505.   if CanClose then postQuitMessage(0);
  506. end;
  507.  
  508. { Draw the chart if it exists }
  509. procedure TChartWindow.Paint(DC: HDC; var PaintInfo: TPaintStruct);
  510. var s : array[0..16] of Char;
  511. begin
  512.   if Chart <> nil then
  513.     Chart^.draw(DC)
  514.   else
  515.   begin
  516.     strPCopy(s, 'Error: No chart');
  517.     TextOut(DC, 10, 10, s, strLen(s));
  518.   end;
  519. end;
  520.  
  521. { Ensure that cursor is visible even when no mouse }
  522. procedure TChartWindow.wmSetFocus(var Msg: TMessage);
  523. begin
  524.   ShowCursor(True);
  525. end;
  526.  
  527. { Return cursor to previous state for other windows }
  528. procedure TChartWindow.wmKillFocus(var Msg: TMessage);
  529. begin
  530.   ShowCursor(False);
  531. end;
  532.  
  533. { Select and item in the chart and edit it }
  534. procedure TChartWindow.wmLButtonDown(var Msg: TMessage);
  535. var Item : PAssoc;
  536.     S : String;
  537. begin
  538. { First locate the item clicked on }
  539.   Item := Chart^.getItem(Msg.LParamLo, Msg.LParamHi);
  540.   if Item <> nil then
  541.   begin
  542.     { Update the edit buffer and edit }
  543.     strLCopy(ItemBuffer.LabelStr, Item^.key, fieldLen-1);
  544.     str(Item^.value,S);
  545.     strPCopy(ItemBuffer.ValueStr, S);
  546.     Change(Msg);
  547.   end
  548.   else
  549.     MessageBeep(0);
  550. end;
  551.  
  552. { Simulate mouse movement with cursor keys }
  553. procedure TChartWindow.wmKeyDown(var Msg: TMessage);
  554. var x, y : Integer;
  555.     pos : TPoint;
  556.     key : word;
  557. begin
  558.   { Determine position of cursor in Window }
  559.   getCursorPos(pos);
  560.   screenToClient(HWindow, pos);
  561.   x:=pos.x;
  562.   y:=pos.y;
  563.   { move the cursor position }
  564.   key := Msg.WParam;
  565.   case key of
  566.     VK_UP    : y := y - 10;
  567.     VK_DOWN  : y := y + 10;
  568.     VK_RIGHT : x := x + 10;
  569.     VK_LEFT  : x := x - 10;
  570.     VK_HOME  :
  571.       begin
  572.     x := 10;
  573.     y := 10;
  574.       end;
  575.     VK_END :
  576.       begin
  577.     x := attr.w - 10;
  578.     y := attr.h - 10;
  579.       end;
  580.     VK_RETURN,
  581.     VK_SPACE,
  582.     VK_F2:
  583.       begin
  584.         { Simulate mouse pressing at cursor position }
  585.         Msg.LParam := LongInt(pos);
  586.     wmLButtonDown(Msg);
  587.       end;
  588.     end;
  589.     { Update position of cursor in window with clipping }
  590.     if x < 1 then x := 10;
  591.     if y < 1 then y := 10;
  592.     if x >= attr.w then x:= attr.w - 10;
  593.     if y >= attr.h then y:= attr.h - 10;
  594.     pos.x := x;
  595.     pos.y := y;
  596.     clientToScreen(HWindow, pos);
  597.     setCursorPos(pos.x, pos.y);
  598. end;
  599.  
  600. { update internal information when resizing then redraw }
  601. procedure TChartWindow.wmSize(var Msg: TMessage);
  602. begin
  603.   attr.h := Msg.lParamHi;
  604.   attr.w := Msg.lParamLo;
  605.   redraw
  606. end;
  607.  
  608.  
  609. {--------------------------------------------------}
  610. { Main program:                                    }
  611. {--------------------------------------------------}
  612.  
  613. var
  614.   ChartApp: TChartApplication;
  615.  
  616. begin
  617.   ChartApp.Init('PChart');
  618.   ChartApp.Run;
  619.   ChartApp.Done;
  620. end.
  621.